COMMENT ⊗   VALID 00005 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "NSORTR"
C00003 00003	   INTEGER ARRAY WIRE[0:N-1,0:NEL-1],STATE[0:N-1,0:NEL-1],NSIZ,NSET[0:NEL-1]
C00006 00004	   INTEGER DONE,FOO,I,J,K,L
C00009 00005	   WIREIT
C00015 ENDMK
C⊗;
BEGIN "NSORTR"
REQUIRE "DDSUB.SAI[GRA,HPM]" SOURCE_FILE;
REQUIRE "PRANDR.SAI[BIG,HPM]" SOURCE_FILE;
WHILE TRUE DO
BEGIN
INTEGER XXTN,N,NOPEN,NEL,NEL1,NN,P,FOO,CHN;
BOOLEAN BIZY;
OUTSTR("N:"); NN←CVD(INCHWL);
OUTSTR("P:"); P←CVD(INCHWL);
RDDCHN(CHN);
SHOW(-1);
N←NN↑P;
NOPEN←NN;
NEL1←NN↑P+2*NN-3;  NEL←3*(NN↑P+NN-3);
NEL←NEL-(NEL-NEL1)%2;
   BEGIN
   INTEGER ARRAY WIRE[0:N-1,0:NEL-1],STATE[0:N-1,0:NEL-1],NSIZ,NSET[0:NEL-1];
   INTEGER ARRAY NEXT,PERM,OUTPUT,INPUTMAP[0:N*NOPEN-1];
   REAL ARRAY X,Y[0:NEL-1];

   PROCEDURE WIREIT;
      BEGIN
      INTEGER I,J,K,L,M;

      PROCEDURE SET(INTEGER L; REAL XV,YV);
         BEGIN X[L]←XV; Y[L]←YV; XXTN←XXTN MAX X[L]+1; END;

      XXTN←0;

      FOR I←0 STEP 1 UNTIL N*NOPEN-1 DO INPUTMAP[I]←I MOD NOPEN;

      FOR I←0 STEP 1 UNTIL NOPEN-1 DO
         BEGIN
         SET(I,1,I+1);
         NSIZ[I]←N;
         FOR J←0 STEP 1 UNTIL N-1 DO
            WIRE[J,I]←J+I+NOPEN-1;
         END;
      
      WIRE[0,0]←-1; WIRE[N-1,NOPEN-1]←-N*NOPEN;

      FOR I←NEL1 STEP 1 UNTIL NEL-1 DO NSIZ[I]←0;

      FOR I←0 STEP 1 UNTIL NEL1-NOPEN-1 DO
         BEGIN
         SET(I+NOPEN,2,1+(NOPEN-1)*I/(NEL1-NOPEN-1));
         NSIZ[I+NOPEN]←(I+2) MIN (NEL1-NOPEN-1-I+2) MIN NOPEN;
         FOR J←0 STEP 1 UNTIL NSIZ[I+NOPEN]-1 DO
            IF ¬((I=0∧J=0)∨(I=NEL1-NOPEN-1∧J=NSIZ[I+NOPEN]-1)) THEN
               BEGIN
               K←J+(IF I<NOPEN-1 THEN I ELSE (I+1)*2-NOPEN);
               L←IF 2*(I+J)<NEL1-NOPEN+3 THEN 0 ELSE NOPEN MOD 2;
               K←NEL1-1+(K+L+1)%2;
               WIRE[J,I+NOPEN]←K;
               NSIZ[K]←NSIZ[K]+1;
               END;
         END;
      WIRE[0,NOPEN]←-2; WIRE[1,NEL1-1]←1-N*NOPEN;

      K←-2;
      FOR I←NEL1 STEP 1 UNTIL NEL-1 DO
         BEGIN
         SET(I,3,(I-NEL1)*(NOPEN-1)/(NEL-1-NEL1)+1);
         FOR J←0 STEP 1 UNTIL NSIZ[I]-1 DO
            WIRE[J,I]←(K←K-1);
         END;

      END;
   INTEGER DONE,FOO,I,J,K,L;
   STRING S; BOOLEAN FIRST,PASS;

   PROCEDURE FOLLOW;
      BEGIN
      INTEGER I,J,K,L;
      DONE←0;
      WHILE DONE<NEL DO FOR I←0 STEP 1 UNTIL NEL-1 DO IF NSET[I]=NSIZ[I] THEN
         BEGIN
         FOR J←1 STEP 1 UNTIL NSIZ[I]-1 DO FOR K←0 STEP 1 UNTIL J-1 DO
            IF STATE[J,I]>STATE[K,I] THEN STATE[J,I]↔STATE[K,I];
         FOR J←0 STEP 1 UNTIL NSIZ[I]-1 DO
            BEGIN
            K←WIRE[J,I];
            IF K≥0 THEN
               BEGIN
               L←NSET[K];
               NSET[K]←L+1;
               STATE[L,K]←STATE[J,I];
               END
            ELSE
               OUTPUT[-1-K]←STATE[J,I];
            END;
         NSET[I]←-NSIZ[I];
         DONE←DONE+1;
         END;
      END;

   PROCEDURE DRAW;
      BEGIN
      INTEGER I,J,K;
      DDINIT;
      SCREEN(-1,-.2,XXTN+2,NOPEN+1.2);
      DRKEN; RECTAN(-100,-100,100,100); LITEN;
      FOR I←0 STEP 1 UNTIL NEL-1 DO
         RECTAN(X[I]-.1,Y[I]-.2*NSIZ[I]/N,X[I]+.2,Y[I]+.2*NSIZ[I]/N);
      FOR I←0 STEP 1 UNTIL N*NOPEN-1 DO
         LINE(0,I*(NOPEN+1)/(N*NOPEN-1),X[INPUTMAP[I]],Y[INPUTMAP[I]]);
      FOR I←0 STEP 1 UNTIL NEL-1 DO
      FOR J←0 STEP 1 UNTIL NSIZ[I]-1 DO
         BEGIN REAL FX,FY;
         FX←X[I]+.2; FY←Y[I]+NSIZ[I]*(J/(NSIZ[I]-1)-.5)*.4/N;
         IF WIRE[J,I]<0 THEN LINE(FX,FY,XXTN,(-1-WIRE[J,I])*(NOPEN+1)/(N*NOPEN-1))
            ELSE LINE(FX,FY,X[WIRE[J,I]],Y[WIRE[J,I]]);
         END;
      OUTSTR("CHANNEL "&CVOS(CHN←GDDCHN(-1))&'15&'12);
      FOR I←1,2,3 DO DPYUP(CHN);
      SHOWA(CHN);
      END;

   STRING PROCEDURE POUT(INTEGER I);
      BEGIN INTEGER J;
      J←1; WHILE N*NOPEN≥10↑J DO J←J+1;
      SETFORMAT(J+1,0);
      RETURN(IF N*NOPEN>27 THEN CVS(I) ELSE '77+I);
      END;
   WIREIT;
   DRAW;

      BEGIN
      INTEGER MAXTRIAL,ACTTRIAL;
      INTEGER ARRAY CNTR[1:N*NOPEN];
      INTEGER ARRAY CHECK[0:N*NOPEN,0:N*NOPEN];
      FOR I←1 STEP 1 UNTIL N*NOPEN DO CNTR[I]←(N*NOPEN-I)%N;
      FIRST←TRUE;
      MAXTRIAL←10;
      ACTTRIAL←0;
      DO
         BEGIN
         K←-1;
         FOR I←N-1 STEP -1 UNTIL 0 DO FOR J←N*NOPEN STEP -1 UNTIL 1 DO
            IF CNTR[J]=I THEN PERM[K←K+1]←J;
         DRKEN; RECTAN(-100,-100,0,100); LITEN;
         FOR K←0 STEP 1 UNTIL N*NOPEN-1 DO
            BEGIN
            TXTPOS(-1.2/N-.01,(K-.5)*(NOPEN+1)/(N*NOPEN-1)-.04/N+.6/N,
               .07/(IF N*NOPEN>27 THEN 2 ELSE 1),.6/N);
            TEXT(POUT(PERM[K]));
            END;
         FOR I←0 STEP 1 UNTIL NEL-1 DO NSET[I]←0;
         FOR I←0 STEP 1 UNTIL N*NOPEN-1 DO
            BEGIN
            K←INPUTMAP[I];
            L←NSET[K];
            NSET[K]←L+1;
            STATE[L,K]←PERM[I];
            END;
         FOLLOW;
         PASS←FALSE;
         FOR K←0 STEP 1 UNTIL N*NOPEN-1 DO
            BEGIN
            L←0; WHILE CHECK[K,L]≠0∧CHECK[K,L]<OUTPUT[K] DO L←L+1;
            IF CHECK[K,L]≠OUTPUT[K] THEN
               BEGIN
               WHILE OUTPUT[K]≠0 DO
                  BEGIN
                  CHECK[K,L]↔OUTPUT[K];
                  L←L+1;
                  END;
               PASS←TRUE;
               END;
            END;
         ACTTRIAL←ACTTRIAL+1;
         IF PASS THEN
            BEGIN
            MAXTRIAL←MAXTRIAL MAX ACTTRIAL;
            ACTTRIAL←0;
            DRKEN; RECTAN(XXTN+.01,-100,100,100); LITEN;
            FOR K←0 STEP 1 UNTIL N*NOPEN-1 DO
               BEGIN
               TXTPOS(XXTN+.03,(K-.5)*(NOPEN+1)/(N*NOPEN-1)-.04/N+.6/N,
                  .07/(IF N*NOPEN>27 THEN 2 ELSE 1),.6/N);
               L←0; WHILE CHECK[K,L]≠0 DO TEXT(POUT(CHECK[K,(L←L+1)-1]));
               END;
            DPYUP(CHN);
            END;
         PWITHR(CNTR,N*NOPEN,FIRST);
         INCHSL(BIZY);
         END UNTIL ¬BIZY ∨ ACTTRIAL>10*MAXTRIAL;
         BEGIN
         INTEGER ARRAY BATCH[0:N*NOPEN-1];
         FOR I←0 STEP 1 UNTIL NEL-1 DO
            FOR J←0 STEP 1 UNTIL NSIZ[I]-1 DO
               IF WIRE[J,I]<0 THEN BATCH[-1-WIRE[J,I]]←I;
         OPEN(1,"DSK",0,0,2,FOO,FOO,FOO);
         SETFORMAT(0,0);
         ENTER(1,"C"&CVS(NOPEN)&"."&CVS(P),FOO);
         I←BATCH[N*NOPEN-1];
         FOR K←N*NOPEN-1 STEP -1 UNTIL 0 DO
            BEGIN
            IF I≠BATCH[K] THEN
               BEGIN
               OUT(1,'15&'12);
               I←BATCH[K];
               END;
            L←0;
            WHILE CHECK[K,L]≠0 DO OUT(1,POUT(CHECK[K,(L←L+1)-1]));
            OUT(1,'15&'12);
            END;
         CLOSE(1);
         OUTSTR("OKAY"&'15&'12&'12);
         END;
      END;

   END;
END;
END;